home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / asuper1a / module1.bas < prev    next >
BASIC Source File  |  1999-10-20  |  3KB  |  54 lines
  1. Attribute VB_Name = "Module1"
  2. Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  3. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  4. Public Declare Function ReleaseCapture Lib "user32" () As Long
  5. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  6. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  7. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  8. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  9. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  10. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  11. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  12. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long) As Long
  13. Private Type BITMAP
  14.     bmType As Long
  15.     bmWidth As Long
  16.     bmHeight As Long
  17.     bmWidthBytes As Long
  18.     bmPlanes As Integer
  19.     bmBitsPixel As Integer
  20.     bmBits As Long
  21. End Type
  22. Public Const WM_NCLBUTTONDOWN = &HA1
  23. Public Const HTCAPTION = 2
  24. Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)
  25.     Dim hRgn As Long, tRgn As Long
  26.     Dim x As Integer, Y As Integer, X0 As Integer
  27.     Dim hDC As Long, BM As BITMAP
  28.     hDC = CreateCompatibleDC(0)
  29.     If hDC Then
  30.         SelectObject hDC, cPicture
  31.         GetObject cPicture, Len(BM), BM
  32.         hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
  33.         For Y = 0 To BM.bmHeight
  34.             For x = 0 To BM.bmWidth
  35.                 While x <= BM.bmWidth And GetPixel(hDC, x, Y) <> cTransparent
  36.                     x = x + 1
  37.                 Wend
  38.                 X0 = x
  39.                 While x <= BM.bmWidth And GetPixel(hDC, x, Y) = cTransparent
  40.                     x = x + 1
  41.                 Wend
  42.                 If X0 < x Then
  43.                     tRgn = CreateRectRgn(X0, Y, x, Y + 1)
  44.                     CombineRgn hRgn, hRgn, tRgn, 4
  45.                     DeleteObject tRgn
  46.                 End If
  47.             Next x
  48.         Next Y
  49.         GetBitmapRegion = hRgn
  50.         DeleteObject SelectObject(hDC, cPicture)
  51.     End If
  52.     DeleteDC hDC
  53. End Function
  54.